home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
BASIC
/
2789.ZIP
/
M2TEST.BAS
< prev
next >
Wrap
BASIC Source File
|
1991-09-28
|
6KB
|
192 lines
DECLARE SUB Monocheck ()
'/TEST PROGRAM FOR MENU 2.
' INCLUDEd files must be available in default drive/directory, or a
' directory specified via the Options/Set Paths... menu/
'$INCLUDE: 'MENU2DCL.BI' '/read in FUNCTION declarations
' needed by Menu 2/
DEFINT A-Z '/default for this module/
'/dimension arrays to hold main and submenu selections & quick
' keys. DIM to the number of main menu entries PLUS 1 and number
' of longest submenu entries PLUS 1. This menu implementation has
' five main menu entries and the longest submenu has 12/
DIM menu$(1 TO 6, 1 TO 13) '/holds main & submenu selections/
DIM qkey(1 TO 6, 1 TO 13) '/holds quick key codes/
DIM spectrum(12) '/spectrum() holds the colour values used by
' all the utilities. All the Menus always use
' spectrum(0) to spectrum(5). spectrum(6) and
' spectrum(7) are reserved for DRAWBOX and
' spectrum(7..11) are reserved for POPHELP/
'/go ask if a mono monitor is being used. If it is change the colours/
CALL Monocheck '/not a routine in the Quick Library/
'**********************************************************************
'/This section of code (between the asterisks) is included for
' demonstration purposes only and may be deleted without affecting
' the operation of the menu/
'/Fill screen background/
sb = spectrum(6)
LOCATE 1, 1
CALL clrbox(sb, 80, 24) '/see manual QUICKREF.DOC
' for details on clrbox/
'/do prompt line (screen row 25)/
COLOR 0, 7
LOCATE 25, 1
PRINT " Pulldown Menu M2 "; CHR$(179);
PRINT " F10 to open menu Alt+X to Exit program ";
'**************************************************************************
'/menu initialisation continues/
menuentries = 5 '/there are 5 menu entries in main menu/
'$INCLUDE: 'MENU12.BI' '/fill menu$() and qkey() from DATA
' statements at end of this module/
'/more initialisation, including print main menu bar along screen row 1/
CALL M2Init(menuentries, menu$(), spectrum())
null$ = CHR$(0) '/needed to recognise Function & Alt keys/
sh = 1 '/turn shadowing on. sh = 0 turns it off/
'/Now we are ready to go. Wait for call to display menus or quit/
DO
DO
sel$ = INKEY$
LOOP WHILE sel$ = "" '/wait for keypress/
SELECT CASE sel$
CASE null$ + CHR$(68) '/F10 key calls menus/
CALL M2Open(menu$(), qkey(), spectrum(), sh)
'/the menu is now open and control will not return to here until the user
' either makes a selection or presses the Escape key/
'/FUNCTION Getkey2 will return 13 if a selection was made. If the user
' dismissed the menu by pressing Escape then Getkey2 will return 27, in
' which case the menu will already have been cleared from the screen/
IF Getkey2 = 13 THEN '/a selection was made/
x = Getmain2 '/get menu$() array co-ordinates
y = Getsub2 ' for main & submenu selection/
'/display the menu selection/
COLOR 0, 7
LOCATE 22, 4
PRINT " Your last menu selection was: ";
LOCATE 23, 4
PRINT SPACE$(34);
LOCATE 23, 5
PRINT RTRIM$(menu$(1, x)); "/"; menu$(x + 1, y)
'/when the user makes a selection the menu is left on screen.
' It's up to you to explicitly dismiss it/
CALL M2Close(menu$()) '/dismiss the menu/
END IF
CASE null$ + CHR$(45) '/Alt + X to terminate program/
CLS
EXIT DO
END SELECT
LOOP
'/DATA statements follow/
'/Main menu selections. Use trailing spaces to format your main menu
' entries along the bar. Do not use leading spaces. Note that the righmost
' main menu entry requires no trailing spaces, and consequently no enclosing
' quotation marks. Each number following a selection represents the POSITION
' in that selection of the "quick key" highlighted letter. Each list of menu
' selections must end with ,#/
DATA "Stars ",1,"Constellations ",1,"Planets ",1
DATA "Signs ",2,Astronauts,1,#
'/Submenu selections/
'/Do not use any leading/trailing spaces in sub menu selections, or you
' will confuse the routine which automatically works out the size of the
' submenu. Where you want a horizontal dividing line you enter *,0, in the
' list of selections. Each horizontal divider counts as one selection when
' you add up the totals for the purpose of dimensioning menu$() and qkey().
' Each list of submenu selections must also end with ,#/
DATA Arcturus,1,Betelgeuse,1,Sirius,1,Aldebaran,3
DATA Formalhaut,1,Canopus,1,Zubenelgenubi,1,#
DATA Canis Major,1,Cassiopeia,7,Andromeda,1
DATA Ursa Minor,1,Corona Borealis,8,#
DATA Mercury,3,Venus,1,*,0,Earth,1,*,0,Mars,1
DATA Jupiter,1,Saturn,1,Uranus,1,Neptune,1,Pluto,1,#
DATA Capricorn,1,Aquarius,1,Pisces,1,Aries,2,Taurus,1,Gemini,1
DATA Cancer,3,Leo,1,Virgo,1,Libra,2,Scorpio,3,Sagittarius,1,#
DATA James T. Kirk,10,Neil Armstrong,6,Yuri Gagarin,1,Doctor Who,8,#
END
SUB Monocheck STATIC
SHARED spectrum()
COLOR 7, 0
CLS
LOCATE 2, 3
PRINT "Press <C> for Colour"
LOCATE 3, 3
PRINT "Press <M> for Monochrome"
DO
sel$ = INKEY$
IF UCASE$(sel$) = "M" THEN
spectrum(0) = 15
spectrum(1) = 0
spectrum(2) = 0
spectrum(3) = 7
spectrum(4) = 7
spectrum(5) = 0
spectrum(6) = 0
EXIT DO
ELSEIF UCASE$(sel$) = "C" THEN
'/Allocate menu colours/
spectrum(0) = 15 '/quick key highlighted letters/
spectrum(1) = 1 '/menu border/
spectrum(2) = 0 '/menu text/
spectrum(3) = 7 '/menu background/
spectrum(4) = 12 '/menu highlight bar text/
spectrum(5) = 0 '/menu highlight bar background/
spectrum(6) = 1 '/not using Drawbox so use spectrum(6)
' for screen backgound colour/
EXIT DO
END IF
LOOP
END SUB